home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / kcl / akcl / akcl1615.lha / lsp / ustreams.lisp < prev   
Lisp/Scheme  |  1990-04-02  |  2KB  |  82 lines
  1.  
  2. ;;;
  3. ;;; This file contains some macros for user defined streams
  4. ;;;
  5. ;;;
  6. ;;; probably need to add some fields to "define-user-stream-type"
  7. ;;;
  8. ;;;
  9. ;;; we probably need the ability for user-defined streams to declare
  10. ;;; whether they are input/output or both
  11. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  12.  
  13. (in-package 'lisp)
  14.  
  15. (export '(make-user-stream define-user-stream-type *user-defined-stream-types*))
  16.  
  17. (defvar *user-defined-stream-types* nil) ;;; list of user defined stream types
  18.  
  19. (defun make-user-stream (str-type)
  20.   (let (struct)
  21.     (unless (member str-type *user-defined-stream-types*)
  22.         (error "Make-user-stream: ~a undefined stream type" str-type))
  23.     (setq struct (funcall (get str-type 'lisp::str-conc-name)))
  24.     (allocate-stream-object str-type struct)))
  25.  
  26. (defmacro define-user-stream-type (str-name
  27.                    str-data
  28.                    str-read-char
  29.                    str-write-char
  30.                    str-peek-char
  31.                    str-force-output
  32.                    str-close
  33.                    str-type
  34.                    &optional str-unread-char)
  35.    (let ((conc-name (intern (concatenate 'string "KCL-" 
  36.                     (symbol-name str-name)))))
  37.      nil
  38.      `(progn
  39.     (setf (get ',str-name 'str-conc-name) ',conc-name)
  40.     (setf (get ',str-name 'stream) t)
  41.     (format t "Constructor ")
  42.     (setq lisp::*user-defined-stream-types* (cons ',str-name lisp::*user-defined-stream-types*))
  43.     (defstruct (,str-name (:constructor ,conc-name))
  44.       (str-data ,str-data)          ;0
  45.       (str-read-char ,str-read-char)    ;1
  46.       (str-write-char ,str-write-char)    ;2
  47.       (str-peek-char ,str-peek-char)    ;3
  48.       (str-force-output ,str-force-output)    ;4
  49.       (str-close ,str-close)        ;5
  50.       (str-type ,str-type)            ;6
  51.       (str-unread-char ,str-unread-char)    ;7
  52.       (str-name ',str-name)))))        ;8
  53.  
  54.  
  55. ;;;
  56. ;;;  allocate a stream-object and patch in the struct which holds
  57. ;;;  the goodies
  58. ;;;
  59. (Clines
  60.  
  61. " object allocate_stream_object (stream_type, new_struct)
  62.  
  63.   object stream_type;
  64.   object new_struct;          
  65.  {
  66.    object x;
  67.    x = alloc_object(t_stream);
  68.    x->sm.sm_mode = smm_user_defined;
  69.    x->sm.sm_object1 = new_struct;
  70.    x->sm.sm_object0 = stream_type;
  71.    x->sm.sm_int0 = 0;
  72.    x->sm.sm_fp = 0;
  73.    x->sm.sm_int1 = 0;
  74.    return x;
  75. }"
  76. )
  77.  
  78. (defentry allocate-stream-object (object object) (object allocate_stream_object)) 
  79.  
  80.  
  81.  
  82.